home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / bitview.exe / FILES.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-05-31  |  6.5 KB  |  264 lines
  1. {**************************************************************************************
  2. *                                                                                     *
  3. *                             Module Name  :  FILES.PAS                               *
  4. *                                    Type  :  UNIT                                    *
  5. *                                                                                     *
  6. **************************************************************************************}
  7.  
  8. unit Files;
  9.  
  10.  
  11.  
  12.  
  13. interface
  14.  
  15.  
  16.  
  17.  
  18. uses
  19.   Wintypes, WinProcs, CommDlg;
  20.  
  21.  
  22. type
  23.   TFilename = array[0..255] of Char;
  24.  
  25.  
  26.  
  27. function LoadBitmap(FileName : PChar; HWindow : HWnd;
  28.                     var Width, Height : LongInt; var hCP : hPalette) : HBitmap;
  29.  
  30. function FileDialog(Owner: HWnd; Filename: PChar; Save: Boolean) : Boolean;
  31.  
  32.  
  33.  
  34. implementation
  35.  
  36.  
  37.  
  38.  
  39.  
  40. function FileDialog(Owner: HWnd; Filename: PChar; Save: Boolean) : Boolean;
  41. const
  42.   DefOpenFilename: TOpenFilename = (
  43.     lStructSize: SizeOf(TOpenFilename);
  44.     hwndOwner: 0;
  45.     hInstance: 0;
  46.     lpstrFilter: 'BMP files (*.BMP)'#0'*.BMP'#0'RLE files (*.RLE)'#0'*.RLE'#0;
  47.     lpstrCustomFilter: nil;
  48.     nMaxCustFilter: 0;
  49.     nFilterIndex: 0;
  50.     lpstrFile: nil;
  51.     nMaxFile: SizeOf(TFilename);
  52.     lpstrFileTitle: nil;
  53.     nMaxFileTitle: 0;
  54.     lpstrInitialDir: nil;
  55.     lpstrTitle: nil;
  56.     Flags: 0;
  57.     nFileOffset: 0;
  58.     nFileExtension: 0;
  59.     lpstrDefExt: 'BMP');
  60. var
  61.   OpenFilename: TOpenFilename;
  62. begin
  63.   OpenFilename := DefOpenFilename;
  64.   OpenFilename.hwndOwner := Owner;
  65.   OpenFilename.lpstrFile := Filename;
  66.   if Save then
  67.   begin
  68.     OpenFilename.Flags := ofn_PathMustExist + ofn_NoChangeDir +
  69.       ofn_OverwritePrompt;
  70.     FileDialog := GetSaveFilename(OpenFilename);
  71.   end else
  72.   begin
  73.     OpenFileName.Flags := ofn_PathMustExist;
  74.     FileDialog := GetOpenFilename(OpenFilename);
  75.   end;
  76. end;
  77.  
  78.  
  79.  
  80.  
  81. { This kind of imitates POINTER ARITHMETIC }
  82.  
  83. function AdvancePointer(CurrentPosition : Pointer; NumberOfBytes : Word) : Pointer;
  84. var
  85.   Seg, Off : Word;
  86.   Adder    : LongInt;
  87. begin
  88.   Seg := Hiword(LongInt(CurrentPosition));
  89.   Off := LoWord(LongInt(CurrentPosition));
  90.  
  91.   Adder := LongInt(Off) + LongInt(NumberOfBytes);
  92.   if (Adder > 65535) then
  93.   begin
  94.     Off := Word(Off + NumberOfBytes);
  95.     Seg := Seg + 8;
  96.   end
  97.   else
  98.     Off := Off + NumberOfBytes;
  99.  
  100.   AdvancePointer := Pointer(Makelong(Off, Seg));
  101. end;
  102.  
  103.  
  104.  
  105.  
  106. { Well folks, wanted to give you a different way to do this, other than Borland's.
  107.   Doesn't depend on the MYSTERY function that the other's rely on. }
  108.  
  109. procedure GetBitmapData(var TheFile : File; BitsHandle : THandle;
  110.                         BitsByteSize : LongInt);
  111. var
  112.   CurrentPosition : Pointer;
  113.   NumberOfBytes   : Word;
  114.  
  115. begin
  116.   CurrentPosition := GlobalLock(BitsHandle);
  117.   while (BitsBytesize > 0) do
  118.   begin
  119.     if (BitsByteSize > 65535) then
  120.       NumberOfBytes := 65535
  121.     else
  122.       NumberOfBytes := BitsByteSize;
  123.  
  124.     BlockRead(TheFile, CurrentPosition^, NumberOfBytes);
  125.     BitsByteSize := BitsByteSize - NumberOfBytes;
  126.     CurrentPosition := AdvancePointer(CurrentPosition, NumberOfBytes);
  127.   end;
  128.   GlobalUnlock(BitsHandle)
  129. end;
  130.  
  131.  
  132.  
  133.  
  134. function IsBitmapFile(FileName : PChar; var F : File) : Boolean;
  135. var
  136.   TestValue : LongInt;
  137.  
  138. begin
  139.   IsBitmapFile := False;
  140.   Assign(F, FileName);
  141.  
  142.   {$I-}
  143.   Reset(F, 1);
  144.   {$I+}
  145.  
  146.   if (IoResult = 0) then
  147.   begin
  148.     Seek(F, 14);
  149.     BlockRead(F, TestValue, SizeOf(TestValue));
  150.     if (TestValue = $28) then
  151.       IsBitmapFile := True
  152.     else
  153.       Close(F);
  154.   end;
  155. end;
  156.  
  157.  
  158.  
  159.  
  160. Procedure CopyDIBPalette(var bmi : TBitMapInfo; var hCP : hPalette);
  161. var
  162.    LogPal : PLogPalette;
  163.  
  164.         i : Longint;
  165.   PalSize : Longint;
  166.        sz : Longint;
  167. begin
  168.   PalSize := 1 shl bmi.bmiHeader.biBitCount;
  169.   sz := Sizeof(TLogPalette)+Pred(PalSize)*Sizeof(TPaletteEntry);
  170.   GetMem(LogPal,sz);
  171.   LogPal^.palNumEntries := PalSize;
  172.   LogPal^.palVersion := $0300;
  173.  
  174. {$R-}
  175.   for i := 0 to Pred(PalSize) do
  176.   begin
  177.     LogPal^.palPalEntry[i].peRed   := bmi.bmicolors[i].RGBRed;
  178.     LogPal^.palPalEntry[i].peGreen := bmi.bmicolors[i].RGBGreen;
  179.     LogPal^.palPalEntry[i].peBlue  := bmi.bmicolors[i].RGBBlue;
  180.     LogPal^.palPalEntry[i].peflags := 0;
  181.   end;
  182. {$R+}
  183.   hCP := CreatePalette(LogPal^);
  184.   FreeMem(LogPal,sz);
  185. end;
  186.  
  187.  
  188.  
  189.  
  190. function LoadBitmap(FileName : PChar; HWindow : HWnd;
  191.                     var Width, Height : LongInt; var hCP : hPalette) : HBitmap;
  192.   var
  193.     BitmapInfo  : PBitmapInfo;
  194.     BmpHandle   : THandle;
  195.     BitsInPixel : Word;
  196.     HeaderSize  : Word;
  197.     LWidth      : LongInt;
  198.     PBits       : Pointer;
  199.     F           : File;
  200.     DC          : HDC;
  201.     OldPalette  : hPalette;
  202.  
  203. begin
  204.   LoadBitmap := 0;
  205.   if (IsBitmapFile(FileName, F)) then
  206.   begin
  207.     Seek(F, 28);
  208.     BlockRead(F, BitsInPixel, Sizeof(BitsInPixel));
  209.     if (BitsInPixel <= 8) then
  210.     begin
  211.       HeaderSize := Sizeof(TBitmapInfoHeader) +
  212.                     ((1 shl BitsInPixel) * Sizeof(TRGBQuad));
  213.       GetMem(BitmapInfo, HeaderSize);
  214.       if (BitmapInfo <> nil) then
  215.       begin
  216.         with BitmapInfo^, BMIHeader do
  217.         begin
  218.           Seek(F, Sizeof(TBitmapFileHeader));
  219.           BlockRead(F, BitmapInfo^, HeaderSize);
  220.           Width := BIWidth;
  221.           Height := BIHeight;
  222.           CopyDIBPalette(BitmapInfo^, hCP);
  223.           if (BICompression = bi_RGB) then
  224.           begin
  225.             LWidth := (((Width * BitsInPixel)+31) div 32) * 4;
  226.             BISizeImage := LWidth * Height;
  227.           end;
  228.           BmpHandle := GlobalAlloc(gmem_Moveable or gmem_ZeroInit, BISizeImage);
  229.           if (BmpHandle <> 0) then
  230.           begin
  231.             GetBitmapData(F, BmpHandle, BISizeImage);
  232.             PBits := GlobalLock(BmpHandle);
  233.             if (PBits <> nil) then
  234.             begin
  235.               DC := CreateDC('Display', nil, nil, nil);
  236.               PBits := GlobalLock(BmpHandle);
  237.  
  238.               OldPalette := SelectPalette(DC, hCP, FALSE);
  239.               UnrealizeObject(hCP);
  240.               RealizePalette(DC);
  241.  
  242.               LoadBitmap := CreateDIBitmap(DC, BMIHeader, cbm_Init, PBits,
  243.                                            BitmapInfo^, 0);
  244.  
  245.               SelectPalette(DC, OldPalette, FALSE);
  246.  
  247.               DeleteDC(DC);
  248.               GlobalUnlock(BmpHandle);
  249.             end;
  250.             GlobalFree(BmpHandle);
  251.           end;
  252.         end;
  253.         FreeMem(BitmapInfo, HeaderSize);
  254.       end;
  255.     end;
  256.     Close(F);
  257.   end;
  258. end;
  259.  
  260.  
  261.  
  262.  
  263. end.
  264.